home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr04 / fntf16ed.zip / FONT16ED.BAS
BASIC Source File  |  1993-07-01  |  10KB  |  339 lines
  1. $STACK 4000
  2. $DYNAMIC
  3. DEFINT A-Z
  4. CLS
  5. DD% = FREEFILE
  6. F$ = COMMAND$
  7. IF F$ <= "  " THEN
  8.   CLS
  9.   PRINT " LOAD FONT NAME FROM COMMAND LINE, REQUIRES MOUSE"
  10.   DELAY 6
  11.   END
  12. END IF
  13.  
  14. SHARED LL$,MouseReady%,FontPoint%,KK$(),FontBuffer$
  15. DIM KK$(17)
  16. LL$ = SPACE$(16)
  17.  
  18. MouseReady% = MouseInitialize%
  19. IF MouseReady% = 0 THEN
  20.   CLS
  21.   PRINT " LOAD FONT NAME FROM COMMAND LINE, REQUIRES MOUSE"
  22.   DELAY 6
  23.   END
  24. END IF
  25.  
  26.  
  27.  
  28. OPEN F$ FOR RANDOM AS #DD% LEN = 16
  29. field #dd%, 16 as FontBuffer$
  30. FontPoint% = 1
  31.  
  32. COLOR 7,1
  33. LOCATE 1,1
  34. PRINT SPACE$(80);
  35. LOCATE 1,3
  36. PRINT "PUBLIC Domain Font Editor for 16 X 8 VGA Fonts by Paul Propst";
  37. LOCATE 3,1
  38. PRINT "IN SCAN MODE ";
  39. COLOR 7,0
  40. LOCATE 24,1
  41. PRINT "F1=EDIT   ESC=DONE/EXIT   UP AND DOWN = CHANGE CHARACTER";
  42. DO
  43.   LOCATE 23,1
  44.   PRINT SPACE$(10);
  45.   LOCATE 23,1
  46.   PRINT "CHAR=";FontPoint%;
  47.  
  48. get #dd%, FontPoint%
  49. LL$ = FontBuffer$
  50. COLOR 7,1
  51. FOR X% = 1 TO 16
  52.    T? = asc(MID$(LL$,X%,1))
  53.    ut% = t?
  54.    KK$(X%) = RIGHT$("00000000" + BIN$(ut%),8)
  55.    'LOCATE X% + 5,50
  56.    'PRINT KK$(X%),tu%;
  57.    locate 5 + x% , 10+1
  58.    print space$(8);
  59.    FOR Y% = 1 TO 8
  60.      LOCATE 5 + X%,10 + Y%
  61.      IF MID$(KK$(X%),Y%,1) = "1" THEN PRINT CHR$(178);
  62.    NEXT Y%
  63. NEXT X%
  64. COLOR 7,0
  65.  
  66. CALL GetCharIn(Char1$,Char2$,MRow%,MCol%)
  67. p$ = CHAR1$ + CHAR2$
  68.  
  69. IF len(p$) = 2 THEN
  70.   ju$ = right$(p$,1)
  71.   select case asc(ju$)
  72.   case 72
  73.     decr FontPoint%
  74.   case 80
  75.     incr FontPoint%
  76.   END select
  77.   IF (FontPoint% > 256) THEN FontPoint% = 1
  78.   IF (FontPoint% < 1) THEN FontPoint% = 256
  79.   LOCATE 23,1
  80.   PRINT SPACE$(10);
  81.   LOCATE 23,1
  82.   PRINT "CHAR=";FontPoint%;
  83.  
  84.   IF JU$ = CHR$(59) THEN CALL EditChar
  85.       '  lset FontBuffer$ = ll$
  86.       '  put #dd%, FontPoint%
  87. else
  88.   IF p$ = chr$(27) THEN
  89.    CLS
  90.    CLOSE
  91.    END
  92.   END IF
  93. END IF
  94. LOOP
  95. END
  96.  
  97. SUB EditChar
  98. SHARED LL$
  99. SHARED FontBuffer$,DD%
  100. 'LOCAL T?
  101. COLOR 7,1
  102. CALL MouseHorizontalRange (11,18)
  103. CALL MouseVerticalRange (6,21)
  104.  
  105. LOCATE 3,1
  106. PRINT "IN EDIT MODE ";
  107.  
  108. DONEEDIT = 0
  109. WHILE NOT DONEEDIT
  110. DELAY .15
  111. CALL GetCharIn(Char1$,Char2$,MRow%,MCol%)
  112.  
  113. IF CHAR1$ = CHR$(13) THEN
  114.   GSCR% = SCREEN(MRow%,MCol%)
  115.   SELECT CASE GSCR%
  116.   CASE 178
  117.     LOCATE MRow%,MCol%
  118.     PRINT CHR$(32);
  119.   CASE 32
  120.     LOCATE MRow%,MCol%
  121.     PRINT CHR$(178);
  122.   END SELECT
  123. END IF
  124.  
  125. IF CHAR1$ = CHR$(27) THEN
  126.    DONEEDIT = -1
  127. END IF
  128. WEND
  129. COLOR 7,0
  130.  
  131. FOR X% = 1 TO 16
  132.    KK$(X%) = STRING$(16,0)
  133.    FOR Y% = 1 TO 8
  134.      AA% = X% + 5
  135.      BB% = Y% + 10
  136.      LOCATE AA%, BB%
  137.      TSCR% = SCREEN(AA%,BB%)
  138.      IF TSCR% = 178 THEN MID$(KK$(X%),Y%,1) = "1" ELSE_
  139.      MID$(KK$(X%),Y%,1) = "0"
  140.    NEXT Y%
  141.    NN$ = "&B" + KK$(X%)
  142.  
  143.    MID$(LL$,X%,1) = CHR$(VAL(NN$))
  144.    LOCATE X% + 5, 50
  145.    PRINT KK$(X%);
  146. NEXT X%
  147.  
  148. Lset FontBuffer$ = LL$
  149. put #dd%, FontPoint%
  150. DELAY .5
  151. LOCATE 3,1
  152. PRINT "IN SCAN MODE ";
  153. COLOR 7,0
  154. END SUB
  155.  
  156.  
  157. '+-------------------------------------------------------------------------+
  158. '|      NAME: MouseInitialize%                                             |
  159. '|   PURPOSE: Find out IF a mouse driver is active                         |
  160. '|                                                                         |
  161. '|    SOURCE: Written by Erik Olson                                        |
  162. '+-------------------------------------------------------------------------+
  163. FUNCTION MouseInitialize%  PUBLIC
  164.     REG 1,0
  165.         CALL INTERRUPT &H33
  166.     MouseInitialize%=REG(1)
  167. END FUNCTION
  168.  
  169. '+-------------------------------------------------------------------------+
  170. '|      NAME: MouseInformation                                             |
  171. '|   PURPOSE: Find mouse location and button status                        |
  172. '|                                                                         |
  173. '|    SOURCE: Written by Erik Olson                                        |
  174. '+-------------------------------------------------------------------------+
  175. SUB MouseInformation(Rgt%, Lft%, Row%, Col%) PUBLIC
  176.     REG 1,3
  177.     CALL INTERRUPT &H33
  178.     SELECT CASE REG(2)
  179.            CASE 1
  180.                 Lft%=1
  181.            CASE 2
  182.                 Rgt%=1
  183.            CASE 3
  184.                 Lft%=1
  185.                 Rgt%=1
  186.     END SELECT
  187.     Row%=REG(4) \ 8 + 1
  188.     Col%=REG(3) \ 8 + 1
  189. END SUB
  190. '+-------------------------------------------------------------------------+
  191. '|      NAME: MouseMoveCursor                                              |
  192. '|   PURPOSE: Directly command mouse location                              |
  193. '|                                                                         |
  194. '|    SOURCE: Written by Erik Olson                                        |
  195. '+-------------------------------------------------------------------------+
  196. SUB MouseMoveCursor (Byval Row%,Byval Col%) PUBLIC
  197.     REG 4, 8 * (Row% - 1)
  198.     REG 3, 8 * (Col% - 1)
  199.     REG 1, 4
  200.     CALL INTERRUPT &H33
  201. END SUB
  202.  
  203. '+-------------------------------------------------------------------------+
  204. '|      NAME: MouseTimesPressed                                            |
  205. '|   PURPOSE: Get last button pressed and status. Get screen location of   |
  206. '|            mouse cursor                                                 |
  207. '|    SOURCE: Written by Erik Olson                                        |
  208. '+-------------------------------------------------------------------------+
  209. SUB MouseTimesPressed (Byval Button%, NumberTimes%, Row%, Col%) PUBLIC
  210. REM Button% should be 0 to return left button info, 1 for right
  211.  
  212.     REG 2, Button%
  213.     REG 1, 5
  214.     CALL INTERRUPT &H33
  215.  
  216.     NumberTimes% = REG(2)
  217.     Row% = REG(4) \ 8 + 1   ' comment out \8+1 for graphics screens
  218.     Col% = REG(3) \ 8 + 1
  219.  
  220. END SUB
  221.  
  222. '+-------------------------------------------------------------------------+
  223. '|      NAME: MouseHorizontalRange                                         |
  224. '|   PURPOSE: Limit mouses horizontal range to specified range and         |
  225. '|            location                                                     |
  226. '|    SOURCE: Written by Erik Olson                                        |
  227. '+-------------------------------------------------------------------------+
  228. SUB MouseHorizontalRange (Byval Rgt%,Byval Lft%) PUBLIC
  229.     REG 3, 8 * (Rgt% - 1)  ' REG 3,Rgt% for graphics screens
  230.     REG 4, 8 * (lft% - 1)  ' REG 4,Lft% for graphics screens
  231.     REG 1, 7
  232.     CALL INTERRUPT &H33
  233. END SUB
  234.  
  235. '+-------------------------------------------------------------------------+
  236. '|      NAME: MouseVerticalRange                                           |
  237. '|   PURPOSE: Limit mouse verticle range  to specified range and           |
  238. '|            locarion                                                     |
  239. '|    SOURCE: Written by Erik Olson                                        |
  240. '+-------------------------------------------------------------------------+
  241. SUB MouseVerticalRange (Byval Top%,Byval Bot%) PUBLIC
  242.     REG 3, 8 * (Top% - 1)  ' REG 3,Top% for graphics screens
  243.     REG 4, 8 * (Bot% - 1)  ' REG 4,Bot% for graphics screens
  244.     REG 1, 8
  245.  
  246.     CALL INTERRUPT &H33
  247. END SUB
  248.  
  249. '+-------------------------------------------------------------------------+
  250. '|      NAME: GetCharIn                                                    |
  251. '|   PURPOSE: Get character and mouse position.  Provide limited           |
  252. '|            translation of button presses to characters                  |
  253. '|    SOURCE: Original code written by Paul Propst                         |
  254. '+-------------------------------------------------------------------------+
  255. SUB GetCharIn(Char1$,Char2$,MRow%,MCol%) PUBLIC
  256. SHARED MouseDelay!
  257. LOCAL IsVisible%,CursTop%,CursBot%,Row%,Col%,Rgt%, Lft%
  258. LOCAL Temp$,Button%, NumberTimes%,LastRow%,LastCol%
  259.  
  260. Char1$ = ""
  261. Char2$ = ""
  262.  
  263. ' Process Mouse
  264. IF (MouseReady% <> 0) THEN
  265.    NumberTimes% = 0
  266.   ' CALL MouseTimesPressed (Button%, NumberTimes%, Row%, Col%)
  267.    CALL MouseInformation (Rgt%, Lft%, Row%, Col%)
  268.    CALL GetCursParams(IsVisible%,CursTop%,CursBot%)
  269.    LOCATE Row%,Col%,1,1,16
  270.    Rgt% = 0
  271.    Lft% = 0
  272.    LastRow% = Row%
  273.    LastCol% = Col%
  274.    DO
  275.       Rgt% = 0
  276.       Lft% = 0
  277.       CALL MouseInformation (Rgt%, Lft%, Row%, Col%)
  278.       'locate 2,10:PRINT Rgt%, Lft%;
  279.       LastRow% = Row%
  280.       LastCol% = Col%
  281.       LOCATE Row%,Col%,1,1,16
  282.       IF (Rgt% <> 0) THEN EXIT LOOP
  283.       IF (Lft% <> 0) THEN EXIT LOOP
  284.       IF INSTAT THEN EXIT LOOP
  285.    LOOP ' UNTIL NumberTimes%
  286.    IF Rgt% THEN Char1$ = chr$(27)
  287.    IF Lft% THEN Char1$ = chr$(13)
  288.    IF Rgt% OR Lft% THEN DELAY MouseDelay!
  289.    MRow% = Row%
  290.    MCol% = Col%
  291. END IF
  292.  
  293. ' Process Keyboard
  294. DO
  295.   IF Char1$ > "" THEN EXIT LOOP
  296.   IF Char2$ > "" THEN EXIT LOOP
  297.   WHILE NOT INSTAT
  298.   WEND
  299.   IF INSTAT THEN Temp$ = INKEY$
  300.   IF LEN(Temp$) = 1 THEN
  301.      Char1$ = Temp$
  302.      Char2$ = ""
  303.      EXIT LOOP
  304.   END IF
  305.   IF LEN(Temp$) = 2 THEN
  306.      Char1$ = CHR$(0)
  307.      Char2$ = RIGHT$(Temp$,1)
  308.      EXIT LOOP
  309.   END IF
  310. LOOP
  311. IF (MouseReady% <> 0) THEN LOCATE Row%,Col%,CursTop%,CursBot%
  312. END SUB
  313.  
  314. '+-------------------------------------------------------------------------+
  315. '|      NAME: GetCursParams                                                |
  316. '|   PURPOSE: Get the current cursor size and visibility                   |
  317. '|                                                                         |
  318. '|    SOURCE: Original code written by Paul Propst                         |
  319. '+-------------------------------------------------------------------------+
  320. SUB GetCursParams(IsVisible%,CursTop%,CursBot%) PUBLIC SHARED
  321.   CursTop% = pbvCursor1
  322.   CursBot% = pbvCursor2
  323.   IF (pbvCursorVis <> 0) THEN IsVisible% = -1  ELSE IsVisible% = 0
  324. END SUB
  325.  
  326. '+-------------------------------------------------------------------------+
  327. '|      NAME: FileThere%                                                   |
  328. '|   PURPOSE: Does at least on file of the file spec exist                 |
  329. '|                                                                         |
  330. '|    SOURCE: Generic since Ver 2.1f                                       |
  331. '+-------------------------------------------------------------------------+
  332. FUNCTION FileThere%(FileSpec$) PUBLIC SHARED
  333. LOCAL af$
  334. FileThere% = 0 'pbvZero
  335. af$ = dir$(FileSpec$)
  336. IF af$ > "" THEN FileThere% = -1 ' pbvMinusOne
  337. END FUNCTION
  338.  
  339.